Sub ()

    Dim Ʈ As Worksheet
    Dim  As Range,  As Range
    Dim ǰڵ As Range
    Dim ġ As Range
    Dim üǼ As Long
    Dim óǼ As Long
    Dim  As Single
        
    For Each Ʈ In Worksheets
        
        If Ʈ.Name <> ActiveSheet.Name Then
        
            üǼ = üǼ + Ʈ.Range("B2").CurrentRegion.Rows.Count - 1
            
        End If
    
    Next
    
    frmȲ.Show vbModeless

    For Each Ʈ In Worksheets
        
        If Ʈ.Name <> ActiveSheet.Name Then
            
            Set  = Ʈ.Range("B3", Ʈ.Cells(Rows.Count, "B").End(xlUp))
            
            For Each  In 
            
                If Columns(2).Find(What:=.Value, LookAt:=xlWhole) Is Nothing Then
            
                    Set ǰڵ = .Resize(1, 4)
                    Set ġ = Cells(Rows.Count, "B").End(xlUp).Offset(1)
                    
                    ǰڵ.Copy ġ
        
                End If
        
                óǼ = óǼ + 1
                 = óǼ / üǼ
            
                With frmȲ
                    .ProgressBar1.Value =  * 100
                    .lbl.Caption = Format(, "0%")
                End With
            
                DoEvents
                
            Next
            
        End If
    
    Next
    
    Range("B2").CurrentRegion.Sort Key1:=Range("B3"), Order1:=xlAscending, Header:=xlYes
        
    Application.OnTime Now + TimeSerial(0, 0, 1), "ݱ"
    
End Sub